Laboratório 5 - Bruno Mitio A. Silva

Recuperação de Imagem

Desenho “purple_wave”

• Carregamos a imagem e transformamos em um data-frame.

library(ggplot2)
library(magrittr)
library(tidyr)

## 
## Attaching package: 'tidyr'

## The following object is masked from 'package:magrittr':
## 
##     extract

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(jpeg)
library(tree)

# a) carrega uma imagem jpeg no R 
img <- readJPEG("C:/Users/Mitio/Desktop/Curso R/curso-r-2016/purple_wave.jpg")

# b) transforma o array da imagem em data.frame com infos de posicao (x,y) e cor (r,g,b)
# dimensões da imagem
img_dim <- dim(img)

# RGB para data.frame
img_df <- data.frame(
  x = rep(1:img_dim[2], each = img_dim[1]),
  y = rep(img_dim[1]:1, img_dim[2]),
  r = as.vector(img[,,1]),
  g = as.vector(img[,,2]),
  b = as.vector(img[,,3])
) %>%
  mutate(cor = rgb(r, g, b),
         id = 1:n())

# para reprodução
set.seed(1) 

# Parte 1) x, y, r, g
img_df_parte1 <- img_df %>% 
  sample_frac(3/5) %>% # separando 3/5 do banco
  mutate(b_backup = b, # backup do azul original
         b = 0, # retirando o azul da imagem
         cor = rgb(r, g, b)) # cor da imagem sem o azul

# Parte 2) x, y, r, g, b
img_df_parte2 <- img_df %>% filter(!id%in%img_df_parte1$id) # filtra as linhas que estão na Parte 1

# Imagem sem o azul
sAzul <- ggplot(data = img_df_parte1, aes(x = x, y = y)) + 
  geom_point(colour = img_df_parte1$cor) +
  labs(x = "x", y = "y", title = "Imagem sem B (azul)") +
  coord_fixed(ratio = 1) +
  theme_bw()
sAzul

# Apenas o azul da imagem
azul <- ggplot(data = img_df_parte2, aes(x = x, y = y)) + 
  geom_point(colour = img_df_parte2$cor) +
  labs(x = "x", y = "y", title = "Apenas o B (azul)") +
  coord_fixed(ratio = 1) +
  theme_bw()
azul

• Descritiva Amostra dos dados

img_dfa <- sample_n(img_df, 500, replace = F)

Matriz de correlação linear

img_dfa %>% select(x, y:b) %>%
  cor %>%
  round(2)

##       x    y     r     g     b
## x  1.00 0.04 -0.02 -0.01 -0.02
## y  0.04 1.00  0.78  0.72  0.77
## r -0.02 0.78  1.00  0.98  1.00
## g -0.01 0.72  0.98  1.00  0.99
## b -0.02 0.77  1.00  0.99  1.00

Matriz de gráficos de dispersão

img_dfa %>% select(x, y:b) %>%
  pairs()

• Modelos preditivos

Regressão. Fórmula proposta com base na análise: b = r + g + u, onde b, r e g são respectivamente as cores: azul, vermelho e verde da imagem, e u é o termo de erro.

lm1 <- lm(b ~ r + g, data = img_df_parte2)

summary(lm1)

## 
## Call:
## lm(formula = b ~ r + g, data = img_df_parte2)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.040943 -0.003067  0.000223  0.002998  0.039914 
## 
## Coefficients:
##               Estimate Std. Error t value Pr(>|t|)    
## (Intercept) -7.384e-04  6.453e-05  -11.44   <2e-16 ***
## r            8.051e-01  7.076e-04 1137.86   <2e-16 ***
## g            3.262e-01  1.195e-03  273.07   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.007144 on 28221 degrees of freedom
## Multiple R-squared:  0.9994, Adjusted R-squared:  0.9994 
## F-statistic: 2.214e+07 on 2 and 28221 DF,  p-value: < 2.2e-16

Árvore de decisão

arv1 <- tree(b ~ r + g, img_df_parte2)
summary(arv1)

## 
## Regression tree:
## tree(formula = b ~ r + g, data = img_df_parte2)
## Variables actually used in tree construction:
## [1] "r"
## Number of terminal nodes:  4 
## Residual mean deviance:  0.003141 = 88.65 / 28220 
## Distribution of residuals:
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1.621e-01 -4.306e-02  7.556e-05  0.000e+00  4.153e-02  1.591e-01

plot(arv1)
text(arv1, pretty = 0)

• Comparação Soma dos erros

predito_arv1p1 <- predict(arv1, img_df_parte1)
predito_lm1p1 <-predict(lm1, img_df_parte1)
predito_arv1p2 <- predict(arv1, img_df_parte2)
predito_lm1p2 <-predict(lm1, img_df_parte2)

img_df_parte2 <- img_df_parte2 %>% 
  mutate(predito_lm1p2,
         predito_arv1p2,
         erro_lm1 = (b - predito_lm1p2)^2,
         erro_arv1 = (b - predito_arv1p2)^2)

Modelo linear

soma_erro_lm1 <- sum(img_df_parte2$erro_lm1)
soma_erro_lm1

## [1] 1.440141

Árvore de decisão

soma_erro_arv1 <- sum(img_df_parte2$erro_arv1)
soma_erro_arv1

## [1] 88.64532

Figura original

img_original1 <- img_df %>% 
  mutate(cor = rgb(r, g, b)) 

original1 <- ggplot(data = img_original1, aes(x = x, y = y)) + 
  geom_point(colour = img_original1$cor) +
  labs(x = "x", y = "y", title = "Imagem original)") +
  coord_fixed(ratio = 1) +
  theme_bw()
original1

Imagem predita no modelo linear

img_df_parte1 <- img_df_parte1 %>% 
  mutate(predito_lm1p1,
         predito_arv1p1)
img_df_parte1$predito_lm1p1[img_df_parte1$predito_lm1p1<0] <- 0           
img_df_parte2$predito_lm1p2[img_df_parte2$predito_lm1p2<0] <- 0           


img_predito1 <- img_df_parte1 %>% 
    mutate(b = predito_lm1p1,
         cor = rgb(r, g, b))
predito1 <- ggplot(data = img_predito1, aes(x = x, y = y)) + 
  geom_point(colour = img_predito1$cor) +
  labs(x = "x", y = "y", title = "Imagem predita 1") +
  coord_fixed(ratio = 1) +
  theme_bw()
predito1

Imagem predita com a árvore de decisão

img_predito2 <- img_df_parte1 %>% 
  mutate(b = predito_arv1p1,
         cor = rgb(r, g, b))
predito2 <- ggplot(data = img_predito2, aes(x = x, y = y)) + 
  geom_point(colour = img_predito2$cor) +
  labs(x = "x", y = "y", title = "Imagem predita 2") +
  coord_fixed(ratio = 1) +
  theme_bw()
predito2

Conclusão: Para este caso, a predição do modelo linear (predito 1) ficou melhor do que o modelo de árvore de decisão. Aparentemente, isto ocorre pelo fato de se tratar de variaveis continuas, onde o método da arvore de decisão não é tão eficiente.

Desenho “xadrez_colorido”

• Carregamos a imagem e transformamos em um data-frame.

# a) carrega uma imagem jpeg no R 
img2 <- readJPEG("C:/Users/Mitio/Desktop/Curso R/curso-r-2016/xadrez_colorido.jpg")

# b) transforma o array da imagem em data.frame com infos de posicao (x,y) e cor (r,g,b)
# dimensões da imagem
img_dim2 <- dim(img2)

# RGB para data.frame
img_df2 <- data.frame(
  x = rep(1:img_dim2[2], each = img_dim2[1]),
  y = rep(img_dim2[1]:1, img_dim2[2]),
  r = as.vector(img2[,,1]),
  g = as.vector(img2[,,2]),
  b = as.vector(img2[,,3])
) %>%
  mutate(cor = rgb(r, g, b),
         id = 1:n())

# para reprodução
set.seed(1) 

# Parte 1) x, y, r, g
img_df_parte1_2 <- img_df2 %>% 
  sample_frac(3/5) %>% # separando 3/5 do banco
  mutate(b_backup = b, # backup do azul original
         b = 0, # retirando o azul da imagem
         cor = rgb(r, g, b)) # cor da imagem sem o azul

# Parte 2) x, y, r, g, b
img_df_parte2_2 <- img_df2 %>% filter(!id%in%img_df_parte1_2$id) # filtra as linhas que estão na Parte 1

# Imagem sem o azul
sAzul2 <- ggplot(data = img_df_parte1_2, aes(x = x, y = y)) + 
  geom_point(colour = img_df_parte1_2$cor) +
  labs(x = "x", y = "y", title = "Imagem sem B (azul)") +
  coord_fixed(ratio = 1) +
  theme_bw()
sAzul2

# Apenas o azul da imagem
azul2 <- ggplot(data = img_df_parte2_2, aes(x = x, y = y)) + 
  geom_point(colour = img_df_parte2_2$cor) +
  labs(x = "x", y = "y", title = "Apenas o B (azul)") +
  coord_fixed(ratio = 1) +
  theme_bw()
azul2

• Descritiva Amostra dos dados

img_dfa2 <- sample_n(img_df2, 500, replace = F)

Matriz de correlação linear

img_dfa2 %>% 
  select(x, y:b) %>%
  cor %>%
  round(2) 

##      x     y     r     g     b
## x 1.00  0.03  0.13  0.01  0.03
## y 0.03  1.00 -0.05 -0.03  0.00
## r 0.13 -0.05  1.00  0.44  0.16
## g 0.01 -0.03  0.44  1.00 -0.02
## b 0.03  0.00  0.16 -0.02  1.00

Matriz de gráficos de dispersão

img_dfa2 %>% select(x, y:b) %>%
  pairs()

• Modelos preditivos

Regressão. Fórmula proposta com base na análise descritiva: b = r + g + u, onde b, r e g são respectivamente as cores: azul, vermelho e verde da imagem, e u é o termo de erro.

lm4 <- lm(b ~ r + g, data = img_df_parte2_2)

summary(lm4)

## 
## Call:
## lm(formula = b ~ r + g, data = img_df_parte2_2)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.31355 -0.14422 -0.12579 -0.02177  0.93585 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.139419   0.004061   34.33   <2e-16 ***
## r            0.174746   0.007678   22.76   <2e-16 ***
## g           -0.157319   0.009108  -17.27   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.3093 on 11589 degrees of freedom
## Multiple R-squared:  0.04688,    Adjusted R-squared:  0.04671 
## F-statistic:   285 on 2 and 11589 DF,  p-value: < 2.2e-16

Árvore de decisão

arv2 <- tree(b ~ r + g, img_df_parte2_2)
summary(arv2)

## 
## Regression tree:
## tree(formula = b ~ r + g, data = img_df_parte2_2)
## Number of terminal nodes:  10 
## Residual mean deviance:  0.02367 = 274.1 / 11580 
## Distribution of residuals:
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -0.92920 -0.03748 -0.02964  0.00000  0.01742  0.76900

plot(arv2)
text(arv2, pretty = 0)

• Comparação Soma dos erros

predito_arv2p1 <- predict(arv2, img_df_parte1_2)
predito_lm4p1 <-predict(lm4, img_df_parte1_2)
predito_arv2p2 <- predict(arv2, img_df_parte2_2)
predito_lm4p2 <-predict(lm4, img_df_parte2_2)

img_df_parte2_2 <- img_df_parte2_2 %>% 
  mutate(predito_lm4p2,
         predito_arv2p2,
         erro_lm4 = (b - predito_lm4p2)^2,
         erro_arv2 = (b - predito_arv2p2)^2)

Modelo linear

soma_erro_lm4 <- sum(img_df_parte2_2$erro_lm4)
soma_erro_lm4

## [1] 1108.977

Árvore de decisão

soma_erro_arv2 <- sum(img_df_parte2_2$erro_arv2)
soma_erro_arv2

## [1] 274.1356

Figura original

img_original2 <- img_df2 %>% 
  mutate(cor = rgb(r, g, b)) 

original2 <- ggplot(data = img_original2, aes(x = x, y = y)) + 
  geom_point(colour = img_original2$cor) +
  labs(x = "x", y = "y", title = "Imagem original)") +
  coord_fixed(ratio = 1) +
  theme_bw()
original2

Imagem predita no modelo linear

img_df_parte1_2 <- img_df_parte1_2 %>% 
  mutate(predito_lm4p1,
         predito_arv2p1)
img_df_parte1_2$predito_lm4p1[img_df_parte1_2$predito_lm4p1<0] <- 0           
img_df_parte2_2$predito_lm4p2[img_df_parte2_2$predito_lm4p2<0] <- 0   

img_predito3 <- img_df_parte1_2 %>% 
  mutate(b = predito_lm4p1,
         cor = rgb(r, g, b))
predito3 <- ggplot(data = img_predito3, aes(x = x, y = y)) + 
  geom_point(colour = img_predito3$cor) +
  labs(x = "x", y = "y", title = "Imagem predita 3") +
  coord_fixed(ratio = 1) +
  theme_bw()
predito3

Imagem predita com a árvore de decisão

img_predito4 <- img_df_parte1_2 %>% 
  mutate(b = predito_arv2p1,
         cor = rgb(r, g, b))
predito4 <- ggplot(data = img_predito4, aes(x = x, y = y)) + 
  geom_point(colour = img_predito4$cor) +
  labs(x = "x", y = "y", title = "Imagem predita 4") +
  coord_fixed(ratio = 1) +
  theme_bw()
predito4

Conclusão: Para este caso, a predição da cor azul peloo modelo de árvore de decisão (predito4) ficou melhor do que o modelo linear. Aparentemente, isto ocorre pelo fato de se tratar de variaveis discretas, onde cada pixel apresenta ausencia ou presença de determinada cor em um valor fixo.

Outros exemplos

• Imagem que seria melhor prevista com o modelo de árvore de decisão.

link_tree <- 'https://janusaureus.files.wordpress.com/2012/05/checked_scrapbook_paper_by_polstars_stock.jpg'
link_tree

## [1] "https://janusaureus.files.wordpress.com/2012/05/checked_scrapbook_paper_by_polstars_stock.jpg"

• Imagem que seria melhor prevista com o modelo de árvore de decisão.

link_lm<- 'http://lounge.obviousmag.org/sphere/2012/01/27/o-vilao-esqueleto-do-desenho-he-man-e-os-defensores-do-universo-1273175358804_300x300.jpg'
link_lm

## [1] "http://lounge.obviousmag.org/sphere/2012/01/27/o-vilao-esqueleto-do-desenho-he-man-e-os-defensores-do-universo-1273175358804_300x300.jpg"